The Arsenal Files 6/The Arsenal Files 6 (Arsenal Computer).ISO/prg_basi/ddfedit.zip/DDFNWFIL.FRM

Text File | 1996-02-04 | 5KB | 183 lines

VERSION 2.00
Begin Form FormNewFile
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Add New File"
   ClientHeight    =   1305
   ClientLeft      =   1785
   ClientTop       =   2040
   ClientWidth     =   4380
   ControlBox      =   0   'False
   Height          =   1710
   Left            =   1725
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1305
   ScaleWidth      =   4380
   Top             =   1695
   Width           =   4500
   Begin TextBox NewFileIDX
      Height          =   285
      Left            =   240
      TabIndex        =   9
      Top             =   840
      Visible         =   0   'False
      Width           =   180
   End
   Begin TextBox XPath
      Height          =   285
      Left            =   0
      TabIndex        =   8
      Top             =   840
      Visible         =   0   'False
      Width           =   180
   End
   Begin CommandButton ButOk
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   330
      Left            =   3060
      TabIndex        =   7
      Top             =   900
      Width           =   1230
   End
   Begin CommandButton butcan
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   330
      Left            =   1485
      TabIndex        =   6
      Top             =   900
      Width           =   1230
   End
   Begin SSPanel Panel3D2
      AutoSize        =   3  'AutoSize Child To Panel
      BevelInner      =   1  'Inset
      BevelOuter      =   0  'None
      BorderWidth     =   1
      Caption         =   "Panel3D1"
      Height          =   285
      Left            =   1485
      TabIndex        =   3
      Top             =   495
      Width           =   2805
      Begin TextBox NewFileLocation
         BorderStyle     =   0  'None
         Height          =   225
         Left            =   30
         MaxLength       =   64
         TabIndex        =   4
         Top             =   30
         Width           =   2745
      End
   End
   Begin SSPanel Panel3D1
      AutoSize        =   3  'AutoSize Child To Panel
      BevelInner      =   1  'Inset
      BevelOuter      =   0  'None
      BorderWidth     =   1
      Caption         =   "Panel3D1"
      Height          =   285
      Left            =   1485
      TabIndex        =   0
      Top             =   90
      Width           =   2805
      Begin TextBox NewFileName
         BorderStyle     =   0  'None
         Height          =   225
         Left            =   30
         MaxLength       =   20
         TabIndex        =   1
         Top             =   30
         Width           =   2745
      End
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Location"
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   135
      TabIndex        =   5
      Top             =   540
      Width           =   1230
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Name"
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   135
      TabIndex        =   2
      Top             =   135
      Width           =   1230
   End
End
Option Explicit

Sub butcan_Click ()
  Unload Me
End Sub

Sub ButOk_Click ()

  Dim stat As Integer
  Dim KeyNum As Integer
  Dim PosBlk As PosBlkDef
  Dim Keybuf As KeyBufDef
  Dim KeyBufLen As Integer
  Dim BufLen As Integer
  Dim FileFullPath As String
  Dim XDFile As XDFile_def
  Dim fidx As Integer
  Dim r As Integer

  NewFileName.Text = Trim(NewFileName.Text)
  NewFileLocation.Text = Trim(NewFileLocation.Text)

  If NewFileName.Text = "" Then
    MsgBox "No Name Supplied", , "Error Creating New File"
    Exit Sub
  End If

  If NewFileLocation.Text = "" Then
    MsgBox "No Location Supplied", , "Error Creating New File"
    Exit Sub
  End If


' ************************************************************************************
' First Add Fields to the FILE.DDF file
' ************************************************************************************


  FileFullPath = XPath.Text & "FILE.DDF"
  Keybuf.kb = FileFullPath
  KeyBufLen = Len(Keybuf)
  BufLen = 0


  status "Adding Fields to file " & FileFullPath

  stat = btrcall(B_OPEN, PosBlk, XDFile, BufLen, Keybuf, KeyBufLen, 0)
  If stat <> 0 Then
    MsgBox "Btrieve Error Opening file " & FileFullPath & Chr(10) & stat & " " & BtErr(stat)
    Exit Sub
  End If


  r = AddRecordToFileDDF((Val(NewFileIDX.Text)), PosBlk, (NewFileName), (NewFileLocation), 0, "")


  stat = btrcall(B_CLOSE, PosBlk, XDFile, BufLen, Keybuf, KeyBufLen, 0)
  Unload Me
End Sub

Sub Form_Load ()
  left = (screen.Width - Width) / 2
  top = (screen.Height - Height) / 2

End Sub